Just Call Me Internet/Just Call Me Internet.iso/prog/atari/m2/cat3src/magic/i/mtlists.i

Modula Implementation | 1997-10-26 | 7.2 KB | 241 lines

(*----------------------------------------------------------------------*
 *                                                                      *
 *  MAGICTOOLS   Modula's  All purpose  GEM  Interface  Cadre  Toolbox  *
 *               ÿ         ÿ            ÿ    ÿ          ÿ               *
 *----------------------------------------------------------------------*
 * Version 3.30  02.02.1992     (C)90/91/92 by Peter Hellinger Software *
 *----------------------------------------------------------------------*
 *            Dieses Modul ist urheberrechtlich geschtzt.              *
 *                                                                      *
 * Die Ver”ffentlichung des Quelltextes oder Teilen daraus, sowie die   *
 * Verbreitung des bersetzten, nicht gelinkten Codes in schriftlicher, *
 * oder maschinenlesbarer Form, insbesondere in Zeitschriften, Mail-    *
 * boxen oder anderen Medien bedarf der ausdrcklichen schriftlichen    *
 * Einverst„ndnisserkl„rung des Autors.                                 *
 *                                                                      *
 * Die Verbreitung des Moduls als Teil eines gelinkten Programms ist    *
 * fr Lizenznehmer ausdrcklich erlaubt!  Der Autor beh„lt sich das    *
 * Recht vor, diese Erlaubnis jederzeit und ohne Angaben von Grnden zu *
 * widerrufen.                                                          *
 *----------------------------------------------------------------------*)

IMPLEMENTATION MODULE mtLists;

(*----------------------------------------------------------------------*
 * Int. Vers | Datum    | Name | Žnderung                               *
 *-----------+----------+------+----------------------------------------*
 *  3.00     | 18.01.92 |  Hp  |                                        *
 *-----------+----------+------+----------------------------------------*)



(* IMPLEMENTATION FšR  >>> Megamax-Modula-2 <<< *)
(*                                              *)
(*$R-   Range-Checks                            *)
(*$S-   Stack-Check                             *)
(*                                              *)
(*----------------------------------------------*)






FROM MagicSys   IMPORT  Nil, Null, Bit0, Bit1, Bit2, Bit3, Bit4, Bit5, Bit6,
                        Bit7, Bit8, Bit9, Bit10, Bit11, Bit12, Bit13, Bit14,
                        Bit15, LOC, Byte, ByteSet, sWORD, sINTEGER, sCARDINAL,
                        sBITSET, lINTEGER, lCARDINAL, lWORD, lBITSET,
                        CastToChar, CastToByte, CastToByteset, CastToInt,
                        CastToCard, CastToBitset, CastToWord, CastToLInt,
                        CastToLCard, CastToLBitset, CastToLWord, CastToAddr,
                        TosVersion, Accessory, Basepage, SysHeader, TosDate;








FROM Storage IMPORT ALLOCATE, DEALLOCATE;




FROM SYSTEM IMPORT  ADDRESS, ADR, TSIZE;

CONST   cMax =          07FFFH;

TYPE    INFO =          POINTER TO ARRAY [0..cMax] OF LOC;

TYPE    ENTRY =         POINTER TO Entry;
        Entry =         RECORD
                         addr: INFO;
                         size: CARDINAL;
                         next: ENTRY;
                         last: ENTRY;
                        END;

TYPE    LIST =          POINTER TO List;
        List =          RECORD
                         start: ENTRY;
                         end:   ENTRY;
                         comp:  CompProc;
                         entry: lCARDINAL;
                        END;


PROCEDURE Copy (from, to: INFO; size: CARDINAL);
VAR c: CARDINAL;
BEGIN
 FOR c:= 0 TO size DO to^[c]:= from^[c]; END;
END Copy;

PROCEDURE NewList (VAR list: LIST; comp: CompProc): BOOLEAN;
BEGIN
 ALLOCATE (list,  TSIZE (List));
 IF list = NIL THEN RETURN FALSE; END;
 list^.start:= NIL;
 list^.comp:= comp;
 RETURN TRUE;
END NewList;

PROCEDURE DisposeList (VAR list: LIST);
VAR p: ENTRY;
BEGIN
 IF list # NIL THEN
  WITH list^ DO
   WHILE start # NIL DO
    p:= start^.next;
    DEALLOCATE (start^.addr, 0);
    DEALLOCATE (start, 0);
    start:= p;
   END;
  END;
  DEALLOCATE (list, 0);
 END;
END DisposeList;

PROCEDURE NilEntry (): ENTRY;
BEGIN
 RETURN NIL;
END NilEntry;

PROCEDURE InsertEntry (list: LIST; info: ARRAY OF LOC): BOOLEAN;
VAR s, t: ENTRY;
    f:    BOOLEAN;
BEGIN
 IF list = NIL THEN  RETURN FALSE;  END;
 ALLOCATE (t,  TSIZE(Entry));  ;
 IF t = NIL THEN  RETURN FALSE;  END;
 t^.size:= HIGH (info);  t^.last:= NIL;  t^.next:= NIL;
 ALLOCATE (t^.addr,  LONG (t^.size));  ;
 IF t^.addr = NIL THEN  DEALLOCATE (t, 0);    RETURN FALSE;  END;
 Copy (ADR(info), t^.addr, t^.size);
 WITH list^ DO
  s:= start;
  IF s = NIL THEN
   start:= t;  end:= t;
  ELSE
   f:= FALSE;
   WHILE (s # NIL) AND NOT f DO
    IF comp (s^.addr, ADR(info)) = smaller THEN  s:= s^.next;
                                           ELSE  f:= TRUE;
    END;
   END;
   t^.next:= s;
   IF s = start THEN
    start:= t;  s^.last:= t
   ELSIF s = NIL THEN
    t^.last:= end;  end^.next:= t;  end:= t;
   ELSE
    t^.last:= s^.last;  s^.last^.next:= t;  s^.last:= t;
   END;
  END;
  INC (entry);
 END;
 RETURN TRUE;
END InsertEntry;

PROCEDURE ListEntries (list: LIST): lCARDINAL;
BEGIN
 IF list = NIL THEN RETURN LONG (0);
               ELSE RETURN list^.entry;
 END;
END ListEntries;

PROCEDURE SearchEntry (list: LIST; from: ENTRY;
                       info: ARRAY OF LOC;  key: CompProc): ENTRY;
VAR s: ENTRY;
    b1, b2: BOOLEAN;
BEGIN
 IF list = NIL THEN  RETURN NIL;  END;
 WITH list^ DO
  s:= start;
  WHILE s # NIL DO
   IF key (s^.addr, ADR (info)) = equal THEN  RETURN s;  END;
   s:= s^.next;
  END;
 END;
 RETURN NIL;
END SearchEntry;

PROCEDURE DeleteEntry (list: LIST; VAR entr: ENTRY);
VAR t: ENTRY;
BEGIN
 IF (list = NIL) OR (entr = NIL) THEN  RETURN;  END;
 WITH list^ DO
  IF entr = start THEN
   t:= start;  start:= start^.next;  start^.last:= NIL;
   IF start = NIL THEN  end:= NIL;  END;
   DEALLOCATE (t^.addr, 0);    DEALLOCATE (t, 0);
   DEC (entry);
  ELSIF entr = end THEN
   t:= end;  end:= end^.last;  end^.next:= NIL;
   DEALLOCATE (t^.addr, 0);    DEALLOCATE (t, 0);
   DEC (entry);
  ELSE
   entr^.next^.last:= entr^.last;
   entr^.last^.next:= entr^.next;
   DEALLOCATE (entr^.addr, 0);  ;  DEALLOCATE (entr, 0);  ;
   DEC (entry);
  END;
 END;
 entr:= NIL;
END DeleteEntry;

PROCEDURE FirstEntry (list: LIST): ENTRY;
BEGIN
 IF list = NIL THEN  RETURN NIL;  END;
 RETURN list^.start;
END FirstEntry;

PROCEDURE LastEntry (list: LIST): ENTRY;
BEGIN
 IF list = NIL THEN  RETURN NIL;  END;
 RETURN list^.end;
END LastEntry;

PROCEDURE NextEntry (entry: ENTRY): ENTRY;
BEGIN
 IF entry = NIL THEN  RETURN NIL;  END;
 RETURN entry^.next;
END NextEntry;

PROCEDURE PrevEntry (entry: ENTRY): ENTRY;
BEGIN
 IF entry = NIL THEN  RETURN NIL;  END;
 RETURN entry^.last;
END PrevEntry;

PROCEDURE GetEntry (entry: ENTRY; VAR info: ARRAY OF LOC): BOOLEAN;
BEGIN
 IF entry = NIL THEN  RETURN FALSE;  END;
 IF HIGH (info) < entry^.size THEN  RETURN FALSE;  END;
 Copy (entry^.addr, ADR(info), entry^.size);
 RETURN TRUE;
END GetEntry;

END mtLists.